VERSION 5.00
Begin VB.UserControl ImageButton 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00F0ECEC&
   ClientHeight    =   1095
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1095
   MaskColor       =   &H00FF00FF&
   PropertyPages   =   "ImageButton.ctx":0000
   ScaleHeight     =   1095
   ScaleMode       =   0  'User
   ScaleWidth      =   1095
   ToolboxBitmap   =   "ImageButton.ctx":0016
   Begin VB.Timer tmrTimer 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   0
      Top             =   0
   End
   Begin VB.PictureBox picPicture 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   615
      Left            =   240
      ScaleHeight     =   615
      ScaleWidth      =   615
      TabIndex        =   0
      Top             =   240
      Visible         =   0   'False
      Width           =   615
   End
End
Attribute VB_Name = "ImageButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Private type
Private Type POINTAPI
    X As Long
    Y As Long
End Type

'Windows api
Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint _
                Lib "user32" (ByVal xPoint As Long, _
                              ByVal yPoint As Long) As Long

'Properties variables
Dim m_Picture      As StdPicture
Dim m_PictureGray  As StdPicture
Dim m_PictureHover As StdPicture
Dim m_PicturePress As StdPicture

Dim m_IsOver       As Boolean
Dim m_State        As Integer

'Events declaration
Event Click()
Event DblClick()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseEnter()
Event MouseLeave()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)

' *********************************************************************************
' PROPERTIES
' *********************************************************************************

Public Property Get Enabled() As Boolean
    Enabled = picPicture.Enabled
End Property

Public Property Let Enabled(m_New_Enabled As Boolean)
    UserControl.Enabled = m_New_Enabled
    picPicture.Enabled = m_New_Enabled
    Call DrawState
    PropertyChanged "Enabled"
End Property

Public Property Get MouseIcon() As Picture
    Set MouseIcon = UserControl.MouseIcon
End Property

Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
    Set UserControl.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property

Public Property Get MousePointer() As MousePointerConstants
    MousePointer = UserControl.MousePointer
End Property

Public Property Let MousePointer(ByVal New_MousePointer As MousePointerConstants)

    If New_MousePointer < vbDefault Then New_MousePointer = vbDefault
    If (New_MousePointer > vbSizeAll) And (New_MousePointer <> vbCustom) Then New_MousePointer = vbSizeAll
    UserControl.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"
End Property

Public Property Get Picture() As StdPicture
    Set Picture = m_Picture
End Property

Public Property Set Picture(m_New_Picture As StdPicture)
    Set m_Picture = m_New_Picture
    Call DrawState
    PropertyChanged "Picture"
End Property

Public Property Get PictureGray() As StdPicture
    Set PictureGray = m_PictureGray
End Property

Public Property Set PictureGray(m_New_PictureGray As StdPicture)
    Set m_PictureGray = m_New_PictureGray
    Call DrawState
    PropertyChanged "PictureGray"
End Property

Public Property Get PictureHover() As StdPicture
    Set PictureHover = m_PictureHover
End Property

Public Property Set PictureHover(m_New_PictureHover As StdPicture)
    Set m_PictureHover = m_New_PictureHover
    Call DrawState
    PropertyChanged "PictureHover"
End Property

Public Property Get PicturePress() As StdPicture
    Set PicturePress = m_PicturePress
End Property

Public Property Set PicturePress(m_New_PicturePress As StdPicture)
    Set m_PicturePress = m_New_PicturePress
    Call DrawState
    PropertyChanged "PicturePress"
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Enabled = PropBag.ReadProperty("Enabled", True)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    UserControl.MousePointer = PropBag.ReadProperty("MousePointer", vbDefault)
    Set m_Picture = PropBag.ReadProperty("Picture", Nothing)
    Set m_PictureGray = PropBag.ReadProperty("PictureGray", Nothing)
    Set m_PictureHover = PropBag.ReadProperty("PictureHover", Nothing)
    Set m_PicturePress = PropBag.ReadProperty("PicturePress", Nothing)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Enabled", Enabled, True)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, vbDefault)
    Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
    Call PropBag.WriteProperty("PictureGray", m_PictureGray, Nothing)
    Call PropBag.WriteProperty("PictureHover", m_PictureHover, Nothing)
    Call PropBag.WriteProperty("PicturePress", m_PicturePress, Nothing)
End Sub

' *********************************************************************************
' FUNCTION
' *********************************************************************************

Public Property Get hwnd() As Long
    hwnd = UserControl.hwnd
End Property

Public Sub Clean()
    Set m_Picture = Nothing
    Set m_PictureGray = Nothing
    Set m_PictureHover = Nothing
    Set m_PicturePress = Nothing
    Call Refresh
End Sub

Public Sub Refresh()
    picPicture.Refresh
    Call DrawState
    UserControl.Refresh
End Sub

' *********************************************************************************
' USER CONTROL
' *********************************************************************************

Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub UserControl_MouseDown(Button As Integer, _
                                  Shift As Integer, _
                                  X As Single, _
                                  Y As Single)

    If Button = vbLeftButton Then
        m_State = 2
        Call DrawState
    End If
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, _
                                  Shift As Integer, _
                                  X As Single, _
                                  Y As Single)

    If Button < 2 Then
        If Not isMouseOver Then
            m_IsOver = False
            m_State = 0
            Call DrawState
        Else

            If Button = 0 And Not m_IsOver Then
                tmrTimer.Enabled = True
                RaiseEvent MouseEnter
                m_IsOver = True
                m_State = 1
                Call DrawState
            ElseIf Button = vbLeftButton Then
                m_IsOver = True
                m_State = 2
                Call DrawState
                m_IsOver = False
            End If
        End If
    End If
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, _
                                Shift As Integer, _
                                X As Single, _
                                Y As Single)

    If isMouseOver Then
        m_State = 1
        Call DrawState
    Else
        m_State = 0
        Call DrawState
    End If
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_Resize()
    On Error Resume Next

    Call DrawState
End Sub

Private Sub UserControl_Show()
    Call DrawState
End Sub

Private Sub UserControl_InitProperties()
    Enabled = True
    Set m_Picture = Nothing
    Set m_PictureGray = Nothing
    Set m_PictureHover = Nothing
    Set m_PicturePress = Nothing
End Sub

' *********************************************************************************
' CUSTOM ROUTINES
' *********************************************************************************

Private Sub DrawState()
    On Error Resume Next

    If Not Enabled Then 'mouse gray
        UserControl.Cls
        UserControl.PaintPicture m_PictureGray, 0, 0
        picPicture.Picture = m_PictureGray
        UserControl.Width = picPicture.Width
        UserControl.Height = picPicture.Height
    ElseIf m_State = 1 Then 'mouse hover
        UserControl.Cls
        UserControl.PaintPicture m_PictureHover, 0, 0
        picPicture.Picture = m_PictureHover
        UserControl.Width = picPicture.Width
        UserControl.Height = picPicture.Height
    ElseIf m_State = 2 Then 'mouse down
        UserControl.Cls
        UserControl.PaintPicture m_PicturePress, 0, 0
        picPicture.Picture = m_PicturePress
        UserControl.Width = picPicture.Width
        UserControl.Height = picPicture.Height
    Else 'mouse normal
        UserControl.Cls
        UserControl.PaintPicture m_Picture, 0, 0
        picPicture.Picture = m_Picture
        UserControl.Width = picPicture.Width
        UserControl.Height = picPicture.Height
    End If
End Sub

Private Function isMouseOver() As Boolean
    On Error GoTo NoMouse:
    Dim mPoint As POINTAPI
    GetCursorPos mPoint
    isMouseOver = (WindowFromPoint(mPoint.X, mPoint.Y) = UserControl.hwnd)
NoMouse:
End Function

Private Sub tmrTimer_Timer()

    If Not isMouseOver Then
        tmrTimer.Enabled = False
        m_IsOver = False
        RaiseEvent MouseLeave
        m_State = 0
        Call DrawState
    End If
End Sub
